home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / perl5 / Immunix / Severity.pm < prev    next >
Encoding:
Perl POD Document  |  2009-11-03  |  6.3 KB  |  223 lines
  1. # $Id: Severity.pm 458 2007-03-20 22:58:38Z jmichael-at-suse-de $
  2. # ------------------------------------------------------------------
  3. #
  4. #    Copyright (C) 2005-2006 Novell/SUSE
  5. #
  6. #    This program is free software; you can redistribute it and/or
  7. #    modify it under the terms of version 2 of the GNU General Public
  8. #    License published by the Free Software Foundation.
  9. #
  10. # ------------------------------------------------------------------
  11.  
  12. package Immunix::Severity;
  13. use strict;
  14. use Data::Dumper;
  15.  
  16. my ($debug) = 0;
  17.  
  18. sub debug {
  19.     print @_ if $debug;
  20. }
  21.  
  22. sub new {
  23.     my $self = {};
  24.     $self->{DATABASENAME} = undef;
  25.     $self->{CAPABILITIES} = {};
  26.     $self->{FILES}        = {};
  27.     $self->{REGEXPS}      = {};
  28.     $self->{DEFAULT_RANK} = 10;
  29.     bless($self);
  30.     shift;
  31.     $self->init(@_) if @_;
  32.     return $self;
  33. }
  34.  
  35. sub init ($;$) {
  36.     my ($self, $resource, $read, $write, $execute, $severity);
  37.     $self = shift;
  38.     $self->{DATABASENAME} = shift;
  39.     $self->{DEFAULT_RANK} = shift if defined $_[0];
  40.     open(DATABASE, $self->{DATABASENAME})
  41.       or die "Could not open severity db $self->{DATABASENAME}: $!\n";
  42.     while (<DATABASE>) {
  43.         chomp();
  44.         next if m/^\s*#/;
  45.         next if m/^\s*$/;
  46.  
  47.         # leading whitespace is fine; maybe it shouldn't be?
  48.         if (/^\s*\/(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s*$/) {
  49.             my ($path, $read, $write, $execute) = ($1, $2, $3, $4);
  50.  
  51.             if (index($path, "*") == -1) {
  52.  
  53.                 $self->{FILES}{$path} = {
  54.                     r => $read,
  55.                     w => $write,
  56.                     x => $execute
  57.                 };
  58.  
  59.             } else {
  60.  
  61.                 my $ptr = $self->{REGEXPS};
  62.                 my @pieces = split(/\//, $path);
  63.  
  64.                 while (my $piece = shift @pieces) {
  65.                     if (index($piece, "*") != -1) {
  66.                         my $path = join("/", $piece, @pieces);
  67.                         my $regexp = convert_regexp($path);
  68.                         $ptr->{$regexp}{SD_RANK} = {
  69.                             r => $read,
  70.                             w => $write,
  71.                             x => $execute
  72.                         };
  73.                         last;
  74.                     } else {
  75.                         $ptr->{$piece} = {} unless exists $ptr->{$piece};
  76.                         $ptr = $ptr->{$piece};
  77.                     }
  78.                 }
  79.             }
  80.         } elsif (m|^\s*CAP|) {
  81.             ($resource, $severity) = split;
  82.             $self->{CAPABILITIES}{$resource} = $severity;
  83.         } else {
  84.             print "unexpected database line: $_\n";
  85.         }
  86.     }
  87.     close(DATABASE);
  88.     debug Dumper($self);
  89.     return $self;
  90. }
  91.  
  92. #rank:
  93. # handle capability
  94. # handle file
  95. #
  96. # handle capability
  97. #   if the name is in the database, return it
  98. #   otherwise, send a diagnostic message to stderr and return the default
  99. #
  100. # handle file
  101. #   initialize the current return value to 0
  102. #   loop over each entry in the database;
  103. #     find the max() value for each mode that matches and set a 'found' flag
  104. #   if the found flag has not been set, return the default;
  105. #   otherwise, return the maximum from the database
  106.  
  107. sub handle_capability ($) {
  108.     my ($self, $resource) = @_;
  109.  
  110.     my $ret = $self->{CAPABILITIES}{$resource};
  111.     if (!defined($ret)) {
  112.         return "unexpected capability rank input: $resource\n";
  113.     }
  114.     return $ret;
  115. }
  116.  
  117. sub check_subtree {
  118.     my ($tree, $mode, $sev, $first, @rest) = @_;
  119.  
  120.     # reassemble the remaining path from this directory level
  121.     my $path = join("/", $first, @rest);
  122.  
  123.     # first check if we have a literal directory match to descend into
  124.     if ($tree->{$first}) {
  125.         $sev = check_subtree($tree->{$first}, $mode, $sev, @rest);
  126.     }
  127.  
  128.     # if we didn't get a severity already, check for matching globs
  129.     unless ($sev) {
  130.  
  131.         # check each glob at this directory level
  132.         for my $chunk (grep { index($_, "*") != -1 } keys %{$tree}) {
  133.  
  134.             # does it match the rest of our path?
  135.             if ($path =~ /^$chunk$/) {
  136.  
  137.                 # if we've got a ranking, check if it's higher than
  138.                 # current one, if any
  139.                 if ($tree->{$chunk}->{SD_RANK}) {
  140.                     for my $m (split(//, $mode)) {
  141.                         if ((!defined $sev)
  142.                             || $tree->{$chunk}->{SD_RANK}->{$m} > $sev)
  143.                         {
  144.                             $sev = $tree->{$chunk}->{SD_RANK}->{$m};
  145.                         }
  146.                     }
  147.                 }
  148.             }
  149.         }
  150.     }
  151.  
  152.     return $sev;
  153. }
  154.  
  155. sub handle_file ($$) {
  156.     my ($self, $resource, $mode) = @_;
  157.  
  158.     # strip off the initial / from the path we're checking
  159.     $resource = substr($resource, 1);
  160.  
  161.     # break the path into directory-level chunks
  162.     my @pieces = split(/\//, $resource);
  163.  
  164.     my $sev;
  165.  
  166.     # if there's a exact match for this path in the db, use that instead of
  167.     # checking the globs
  168.     if ($self->{FILES}{$resource}) {
  169.  
  170.         # check each piece of the passed mode against the db entry
  171.         for my $m (split(//, $mode)) {
  172.             if ((!defined $sev) || $self->{FILES}{$resource}{$m} > $sev) {
  173.                 $sev = $self->{FILES}{$resource}{$m};
  174.             }
  175.         }
  176.  
  177.     } else {
  178.  
  179.         # descend into the regexp tree looking for matches
  180.         $sev = check_subtree($self->{REGEXPS}, $mode, $sev, @pieces);
  181.  
  182.     }
  183.  
  184.     return (defined $sev) ? $sev : $self->{DEFAULT_RANK};
  185. }
  186.  
  187. sub rank ($;$) {
  188.     my ($self, $resource, $mode) = @_;
  189.  
  190.     if (substr($resource, 0, 1) eq "/") {
  191.         return $self->handle_file($resource, $mode);
  192.     } elsif (substr($resource, 0, 3) eq "CAP") {
  193.         return $self->handle_capability($resource);
  194.     } else {
  195.         return "unexpected rank input: $resource\n";
  196.     }
  197. }
  198.  
  199. sub convert_regexp ($) {
  200.     my ($input) = shift;
  201.  
  202.     # we need to convert subdomain regexps to perl regexps
  203.     my $regexp = $input;
  204.  
  205.     # escape + . [ and ] characters
  206.     $regexp =~ s/(\+|\.|\[|\])/\\$1/g;
  207.  
  208.     # convert ** globs to match anything
  209.     $regexp =~ s/\*\*/.SDPROF_INTERNAL_GLOB/g;
  210.  
  211.     # convert * globs to match anything at current path level
  212.     $regexp =~ s/\*/[^\/]SDPROF_INTERNAL_GLOB/g;
  213.  
  214.     # convert {foo,baz} to (foo|baz)
  215.     $regexp =~ y/\{\}\,/\(\)\|/ if $regexp =~ /\{.*\,.*\}/;
  216.  
  217.     # twiddle the escaped * chars back
  218.     $regexp =~ s/SDPROF_INTERNAL_GLOB/\*/g;
  219.     return $regexp;
  220. }
  221.  
  222. 1;    # so the require or use succeeds
  223.